(require
 (lib "1.ss" "srfi") ;list library
 (lib "42.ss" "srfi")
 "utils.scm"
 "fst.scm"
 "graph-canvas.scm"
 "state.scm"
 "transition.scm")
;; errortrace)

;(profiling-enabled #t)
;(profile-paths-enabled #t)
;(get-profile-results)

;;Callbacks for the menu-items
(define sequence-type 'DeBruijn)

(define (file-menu-new-callback item event)
  (send left-canvas reset)
  (send right-canvas reset))

(define (file-menu-new-random-fst-callback item event)
  (send (get-field fst right-canvas)
        create-random-fst
        (map
         (lambda (x)
           (list->string
            `(,(integer->char
                (+ (char->integer #\a) x)))))
         (iota (string->number (get-input "number of nodes"))))
        '("0" "1")
        '("S" "F")))

(define (file-menu-open-callback item event)
  (send right-canvas reset)
  (send (get-field fst right-canvas) open (get-input "filename"))
  (send right-canvas refresh))


(define (file-menu-save-callback item event)
  (send* (get-field fst right-canvas)
         [save (get-input "filename")]))


(define (file-menu-exit-callback item event)
  (when (send frame can-close?)
        (send frame on-close)
        (send frame show #f)))

(define (mode-menu-machine-rover-callback item event) '()) ;todo
(define (mode-menu-machine-hider-callback item event) '()) ;todo

(define (mode-menu-two-machines-callback item event)
  (send left-canvas reset)
  (let* ((left-fst (get-field fst left-canvas))
         (right-fst (get-field fst right-canvas)))
    (for ([s (send right-fst get-outputs)])
         (send left-fst add-output-symbol s))
    (for ([s (send right-fst get-inputs)])
         (send left-fst add-input-symbol s))
    (printd "~n")
    (printd "left inputs ~s~n" (send left-fst get-inputs))
    (printd "left outputs ~s~n" (send left-fst get-outputs))
    (printd "right inputs ~s~n" (send right-fst get-inputs))
    (printd "right outputs ~s~n" (send right-fst get-outputs))
    (call-with-continuation-prompt
     (lambda () (send left-fst next-fst)))))

(define (mode-menu-toggle-debug-callback item event)
  (toggle-debug))

(define (sequence-menu-DeBruijn-callback item event)
  (send (get-field fst left-canvas) set-sequence-type! 'DeBruijn))

(define (sequence-menu-Linus-callback item event)
  (send (get-field fst left-canvas) set-sequence-type! 'Linus))

(define (sequence-menu-Random-callback item event)
  (send (get-field fst left-canvas) set-sequence-type! 'Random))

(define (help-menu-help-callback item event) '()) ;todo


;; Show about dialog box
(define (help-menu-about-callback item event)
  (let ((dialog (instantiate dialog% ("About"))))
    (new message%
         [parent (new horizontal-panel%
                      [parent dialog]
                      [alignment '(center center)])]
         [label "Graph Explorer\nMarty Neal"])
    (new button%
         [label "OK"]
         [parent (new horizontal-panel%
                      [parent dialog]
                      [alignment '(center center)])]
         [callback (lambda (x y) (send dialog show #f))])
    (send dialog show #t)))

;; Make a frame by instantiating the frame% class
(define frame (new frame% [label "Example"] [width 500] [height 500]))

;; Create the main menu bar
(define menu-bar (new menu-bar% [parent frame]))

;; Create the menus
(for-each create-menu
          '(file mode sequence help)
          (append (make-list 4 'menu-bar)))

;; Create the menu-items
(for-each create-menu-item
          '(new new-random-fst open save exit
                machine-rover machine-hider two-machines toggle-debug
                DeBruijn Linus Random
                help about)
          (append (make-list 5 'file-menu) (make-list 4 'mode-menu)
                  (make-list 3 'sequence-menu) (make-list 2 'help-menu)))

;; Create the drawing areas
(define dual-pane (new horizontal-pane% (parent frame)))
(define left-canvas (new graph-canvas% (parent dual-pane) (label "left")))
(define right-canvas (new graph-canvas% (parent dual-pane) (label "right")))
(define left-fst (get-field fst left-canvas))
(define right-fst (get-field fst right-canvas))

;; Create the status line
(send frame create-status-line)

;; And we're off!
(send frame show #t)
(send (get-field fst right-canvas) open "abc.dot")
(printf "~n")

;;Main

(define TRIAL_COUNT 100)
(define DeBruijnData '())
(define LinusData '())
(define RandomData '())

(do ((i 0 (+ i 1)))
    ((= i TRIAL_COUNT))

  (printf "trial ~s~n" i)
  ;;create a random fst
  (send right-fst create-random-fst '("a" "b" "c") '("0" "1") '("S" "F"))
  (send right-fst set-input-history! '())
  (send right-fst set-output-history! '())
  (send right-fst set-cur-state! (car (send right-fst get-states)))
  ;;save the random fst for reproducibility
  (send right-fst save (format "Random-~s~s~s-~s.dot"
                               (length (send right-fst get-states))
                               (length (send right-fst get-inputs))
                               (length (send right-fst get-outputs)) i))
  ;;prep the left fst
  (send left-canvas reset)
  (set! left-fst (get-field fst left-canvas))
  ;;prep the right fst
  (send right-fst set-input-history! '())
  (send right-fst set-output-history! '())
  (send right-fst set-cur-state! (car (send right-fst get-states)))
  ;;attempt to learn the machine using Random sequences
  (send left-fst set-sequence-type! 'Random)
  (for ([s (send right-fst get-outputs)]) (send left-fst add-output-symbol s))
  (for ([s (send right-fst get-inputs)]) (send left-fst add-input-symbol s))
  (call-with-continuation-prompt (lambda () (send left-fst next-fst)))
  (do ((j 0 (+ j 1)))
      ((or (= j 200) (send right-fst fst-equal? left-fst)))
    (send left-fst next-step))
  ;;save how long that took
  (cons-last! (length (send left-fst get-input-history)) RandomData)
  (printd "Found it~n")
  ;;prep the left fst
  (send left-canvas reset)
  (set! left-fst (get-field fst left-canvas))
  ;;prep the right fst
  (send right-fst set-input-history! '())
  (send right-fst set-output-history! '())
  (send right-fst set-cur-state! (car (send right-fst get-states)))
  ;;attempt to learn the machine using DeBruijn sequences
  (send left-fst set-sequence-type! 'DeBruijn)
  (for ([s (send right-fst get-outputs)]) (send left-fst add-output-symbol s))
  (for ([s (send right-fst get-inputs)]) (send left-fst add-input-symbol s))
  (call-with-continuation-prompt (lambda () (send left-fst next-fst)))
  (do ((j 0 (+ j 1)))
      ((or (= j 60) (= (last RandomData) 200) (send right-fst fst-equal? left-fst)))
    (send left-fst next-step))
  ;;save how long that took
  (cons-last! (length (send left-fst get-input-history)) DeBruijnData)
  ;;prep the left fst
  (send left-canvas reset)
  (set! left-fst (get-field fst left-canvas))
  ;;prep the right fst
  (send right-fst set-input-history! '())
  (send right-fst set-output-history! '())
  (send right-fst set-cur-state! (car (send right-fst get-states)))
  ;;attempt to learn the machine using Linus sequences
  (send left-fst set-sequence-type! 'Linus)
  (for ([s (send right-fst get-outputs)]) (send left-fst add-output-symbol s))
  (for ([s (send right-fst get-inputs)]) (send left-fst add-input-symbol s))
  (call-with-continuation-prompt (lambda () (send left-fst next-fst)))
  (do ((j 0 (+ j 1)))
      ((or (= j 200) (= (last RandomData) 200) (send right-fst fst-equal? left-fst)))
    (send left-fst next-step))
  ;;save how long that took
  (cons-last! (length (send left-fst get-input-history)) LinusData))

(printf "Random data = ~s~n" RandomData)
(printf "DeBruijn data = ~s~n" DeBruijnData)
(printf "Linus data = ~s~n" LinusData)
